home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / simula / books / books.lha / kirkerud / weather.sim < prev   
Text File  |  1993-08-16  |  11KB  |  311 lines
  1. begin
  2.  
  3. ! This is the program constructed in chapter 7 of 
  4. ! Object Oriented Programming with Simula by Bj|rn Kirkerud;
  5.  
  6.  
  7. ! Declaration of data structure:  ;
  8.  
  9.   real array    rain, min_temp, max_temp(1 : 365);
  10.   Boolean array sunny(1 : 365);
  11.   Boolean array data_known(1 : 365);
  12.   integer array days_in_month, month_start, month_end(1 : 12);
  13.  
  14.  
  15. ! Declarations of a variable to keep the latest command entered by the user: ; 
  16.  
  17.   character command;
  18.  
  19. ! Declaration of a Boolean variable which is true if all data entered by the 
  20. ! user have been written to file, false otherwise:  ;
  21.  
  22.   Boolean file_updated;
  23.  
  24.  
  25. ! Declarations of one procedure for each command:  ;
  26.  
  27.   procedure Give_help;
  28.     begin
  29.       User_message("The legal commands are: ");
  30.       User_message("   ?:  Help (writes this text)");
  31.       User_message("   E:  To enter data about a single day");
  32.       User_message("   Y:  Writes data about a full year");
  33.       User_message("   P:  Writes data about a month");
  34.       User_message("   D:  Writes data about a single day");
  35.       User_message("   F:  Writes all data to file ""meth.dta""");
  36.       User_message("   R:  Reads data from file ""meth.dta""");
  37.       User_message("   H:  Writes  histograms");
  38.       User_message("   S:  Produces some statistics");
  39.       User_message("   W:  Finds the worst days in each month"); 
  40.       User_message("   Q:  Quit (the program execution stops)"); 
  41.     end of Give_help;
  42.  
  43.   procedure Enter_day;
  44.     begin integer m, d, day_in_year;
  45.       m := prompt_for_int("Which month (give its number)? ");
  46.       d := prompt_for_int("Which day in the month? ");
  47.       if not (1 <= m and then m <= 12 and then
  48.               1 <= d and then d <= days_in_month(m))
  49.          then Error_message("Illegal month or day")
  50.          else begin
  51.            day_in_year := month_start(m) - 1 + d; 
  52.            rain(day_in_year)     := prompt_for_real("How much rain that day? ");
  53.            min_temp(day_in_year) := prompt_for_real("Minimum temperature? ");
  54.            max_temp(day_in_year) := prompt_for_real("Maximum temperature? ");
  55.            sunny(day_in_year)    := prompt_for_bool("Was the day sunny? ");
  56.            data_known(day_in_year) := true;
  57.            file_updated := false;
  58.          end;
  59.     end of Enter_day;
  60.  
  61.   procedure Write_year; not_implemented("Write year");
  62.  
  63.   procedure Write_month;
  64.     begin integer m, day_in_year; Boolean some_written;
  65.       m := prompt_for_int("Which month (give its number)? ");
  66.       if not (1 <= m and m <= 12) then Error_message("Illegal month")
  67.       else begin
  68.           outtext("Day    Rain   Minimum temp.  Maximum temp.  Sunny?"); outimage;
  69.           for day_in_year := month_start(m) step 1 until month_end(m) do
  70.             if data_known(day_in_year) then 
  71.               begin 
  72.                 outint(day_in_year - month_start(m) + 1, 2);
  73.                 outfix(rain(day_in_year), 1, 8);
  74.                 outfix(min_temp(day_in_year), 1, 12);
  75.                 outfix(max_temp(day_in_year), 1, 15); outtext("        "); 
  76.                 outtext(if sunny(day_in_year) then "yes" else "no");
  77.                 outimage;
  78.                 some_written := true;
  79.               end;
  80.           if not some_written then 
  81.             begin outtext("   No data known for this month!"); outimage end;
  82.         end;
  83.     end of Write_month;
  84.  
  85.   procedure Write_day; not_implemented("Write day");
  86.  
  87.   procedure Write_to_file;
  88.     begin integer day_in_year, days_written; 
  89.       inspect new outfile("meth.dta") do
  90.         begin
  91.           open(blanks(24));
  92.           for day_in_year := 1 step 1 until 365 do
  93.             if data_known(day_in_year) then
  94.               begin 
  95.                 outint(day_in_year, 3); 
  96.                 outfix(rain(day_in_year), 1, 7);
  97.                 outfix(min_temp(day_in_year), 1, 6);
  98.                 outfix(max_temp(day_in_year), 1, 6);
  99.                 outint(if sunny(day_in_year) then 0 else 1, 2);
  100.                 outimage;
  101.                 days_written := days_written + 1;
  102.               end;
  103.           close;
  104.         end of inspect outfile;
  105.       if days_written > 0 then
  106.         begin      
  107.           file_updated := true;
  108.           outtext("Data for "); outint(days_written, 3); 
  109.           outtext(" days have been written to file ""meth.dta""."); outimage;
  110.         end 
  111.       else User_message("   No data known. Nothing written to file.");
  112.       file_updated := true;
  113.     end of Write_to_file;
  114.  
  115.   procedure Read_from_file;
  116.     begin 
  117.       integer day_in_year, days_read;
  118.       inspect new infile("meth.dta") do
  119.         if open(blanks(24)) then
  120.           begin
  121.             inimage; 
  122.             while not endfile do
  123.               begin 
  124.                 day_in_year := inint;
  125.                 rain(day_in_year)     := inreal;
  126.                 min_temp(day_in_year) := inreal;
  127.                 max_temp(day_in_year) := inreal;
  128.                 sunny(day_in_year)    := inint = 1;
  129.                 data_known(day_in_year) := true; 
  130.                 days_read := days_read + 1;
  131.                 inimage;
  132.               end;
  133.             close;
  134.           end;
  135.       if days_read > 0 then
  136.         begin      
  137.           outtext("Data for "); outint(days_read, 3); 
  138.           outtext(" days have been read from file ""meth.dta"".");
  139.           outimage;
  140.         end 
  141.       else User_message("   No data found on file ""meth.dta""");
  142.       file_updated := true;
  143.     end of Read_from_file;
  144.  
  145.   procedure Write_histograms; not_implemented("Write histograms");
  146.  
  147.   procedure Produce_statistics; not_implemented("Produce statistics");
  148.  
  149.   procedure Find_worst_days;
  150.     begin
  151.       integer m, day1, day2; 
  152.       Boolean mintemp_found, maxrain_found;
  153.       real minmintemp, maxrain;
  154.       outtext("The worst days:"); outimage;
  155.       for m := 1 step 1 until 12 do
  156.         begin
  157.           min_in_tab(min_temp, data_known, 
  158.             month_start(m), month_end(m), 
  159.                     mintemp_found, minmintemp, day1);
  160.           max_in_tab(rain, data_known, 
  161.              month_start(m), month_end(m), 
  162.                      maxrain_found, maxrain, day2);
  163.           outtext("In month "); outint(m, 2); outchar(':'); outimage;
  164.           if mintemp_found then
  165.             begin
  166.               outtext("    It was coldest on day"); 
  167.               outint(day1 - month_start(m) + 1, 3); 
  168.               outtext(" with minimum temperature"); outfix(minmintemp, 1, 5);
  169.               outtext(" degrees.");  outimage;
  170.             end;
  171.           if maxrain_found then
  172.             begin
  173.               outtext("    It rained most on day"); 
  174.               outint(day2 - month_start(m) + 1, 3); 
  175.               outtext(" with "); outfix(maxrain, 1, 5); 
  176.               outtext(" mm."); outimage;
  177.             end;
  178.           if not (mintemp_found or maxrain_found) then
  179.             User_message("    No data known for this month!"); 
  180.         end;
  181.     end of Find_worst_days;
  182.  
  183.  
  184. ! Declarations of some auxiliary procedures:  ;
  185.  
  186.   procedure Unknown_command(c); character c;
  187.     begin
  188.       outtext("   You gave the command '"); outchar(c);
  189.       outtext("'.  This is not among the legal commands."); outimage;
  190.       outtext("   Type ? if you don't remember the legal commands"); outimage;
  191.     end of Unknown command;
  192.  
  193.  
  194.   procedure not_implemented(action_name); text action_name;
  195.     begin 
  196.       outtext("   You gave the command """); outtext(action_name);
  197.       outtext(""".  This has not been implemented yet!"); outimage;
  198.       outtext("   Try another command!"); outimage;
  199.     end;
  200.  
  201.  
  202.   procedure Initialize_months;
  203.     begin integer m;
  204.       days_in_month( 1) := 31;  days_in_month( 2) := 28;
  205.       days_in_month( 3) := 31;  days_in_month( 4) := 30;
  206.       days_in_month( 5) := 31;  days_in_month( 6) := 30;
  207.       days_in_month( 7) := 31;  days_in_month( 8) := 31;
  208.       days_in_month( 9) := 30;  days_in_month(10) := 31;
  209.       days_in_month(11) := 30;  days_in_month(12) := 31;
  210.       month_start(1) := 1;
  211.       for m := 2 step 1 until 12 do 
  212.         month_start(m) := month_start(m-1) + days_in_month(m-1);
  213.       for m := 1 step 1 until 12 do 
  214.         month_end(m) := month_start(m) + days_in_month(m) - 1;
  215.     end of Initialize_months;
  216.  
  217.  
  218.  
  219. ! Declarations of some procedures of general utility:   ;
  220.  
  221.   procedure User_message(message); text message;
  222.     begin outtext(message); outimage end;
  223.  
  224.   procedure Error_message(message); text message;
  225.     begin outtext("** Error **" & message); outimage end;
  226.  
  227.   character procedure prompt_for_char(prompt); text prompt;
  228.     begin 
  229.       outtext(prompt); breakoutimage;
  230.       inimage; prompt_for_char := inchar;
  231.     end of prompt_for_char;
  232.  
  233.   Boolean procedure prompt_for_bool(prompt); text prompt;
  234.     begin character c;
  235.       outtext(prompt); breakoutimage;
  236.       inimage; c := inchar;
  237.       prompt_for_bool := c = 'y' or c = 'Y';
  238.     end of prompt_for_bool;
  239.  
  240.   real procedure prompt_for_real(prompt); text prompt;
  241.     begin 
  242.       outtext(prompt); breakoutimage;
  243.       inimage; prompt_for_real := inreal;
  244.     end of prompt_for_real;
  245.  
  246.   integer procedure prompt_for_int(prompt); text prompt;
  247.     begin 
  248.       outtext(prompt); breakoutimage;
  249.       inimage; prompt_for_int := inint;
  250.     end of prompt_for_int;
  251.  
  252.   procedure min_in_tab(tab, val_ok, lowind, highind, 
  253.                min_val_found, min_val, min_ind);
  254.       name min_val_found, min_val, min_ind;
  255.       real array tab; Boolean array val_ok;
  256.       Boolean min_val_found; integer lowind, highind; real min_val, min_ind;
  257.     begin integer ind;
  258.       min_val := maxreal; min_val_found := false;
  259.       for ind := lowind step 1 until highind do
  260.         if val_ok(ind) and then tab(ind) < min_val then
  261.             begin min_val := tab(ind); min_ind := ind; min_val_found := true end;
  262.     end of min_in_tab;
  263.  
  264.   procedure max_in_tab(tab, val_ok, lowind, highind, 
  265.                max_val_found, max_val, max_ind);
  266.       name max_val_found, max_val, max_ind;
  267.       real array tab; Boolean array val_ok;
  268.       Boolean max_val_found; integer lowind, highind; real max_val, max_ind;
  269.     begin integer ind;
  270.       max_val := minreal; max_val_found := false;
  271.       for ind := lowind step 1 until highind do
  272.         if val_ok(ind) and then tab(ind) > max_val then
  273.             begin max_val := tab(ind); max_ind := ind; max_val_found := true end;
  274.     end of max_in_tab;
  275.  
  276.  
  277. ! That was the end of the declarations.
  278. ! Now come the imperatives of the program:  ;
  279.  
  280.   Initialize_months;
  281.  
  282.   file_updated := true;
  283.  
  284.   command := prompt_for_char("Type your first command (type ? for help) > ");
  285.   while command ne 'Q' do
  286.     begin
  287.       if command = '?' then Give_help else
  288.       if command = 'E' then Enter_day else
  289.       if command = 'Y' then Write_year else
  290.       if command = 'P' then Write_month else
  291.       if command = 'D' then Write_day else
  292.       if command = 'F' then Write_to_file else
  293.       if command = 'R' then Read_from_file else
  294.       if command = 'H' then Write_histograms else
  295.       if command = 'S' then Produce_statistics else
  296.       if command = 'W' then Find_worst_days 
  297.       else Unknown_command(command);
  298.       command := prompt_for_char("Your next command > ");
  299.     end;
  300.  
  301.   if  not file_updated then
  302.     begin 
  303.       User_message("Some of your data has not been written to file."); 
  304.       if prompt_for_bool("Do you want them written to file? ")
  305.           then Write_to_file;
  306.     end;
  307.  
  308.   User_message("Bye");
  309.  
  310. end
  311.